home *** CD-ROM | disk | FTP | other *** search
- (*===========================================================================*)
- (* Session services *)
- (* *)
- (* Copyright 1988, 1989, 1990, 1991 by H. Roy Engehausen. All rights *)
- (* reserved. *)
- (* *)
- (*===========================================================================*)
-
- UNIT BBSESS;
-
- INTERFACE
-
- USES
- bbdummy;
-
- PROCEDURE end_session(add_delay : BOOLEAN);
- PROCEDURE timer_end_session;
- PROCEDURE task_wait (seconds_to_wait : WORD; poll_during_wait : BOOLEAN);
- PROCEDURE cmd_tnc(cmd_string : str_ptr; display_switch : BOOLEAN);
-
- IMPLEMENTATION
-
- USES
- bblstr,
- bbmdata,
- bbmess,
- bbmisc,
- bbrdata,
- bbsdata,
- bbsrt,
- bbtask,
- bbtime,
- bbwin;
-
- (*===========================================================================*)
- (* Command TNC *)
- (*===========================================================================*)
-
- PROCEDURE cmd_tnc(cmd_string : str_ptr; display_switch : BOOLEAN);
-
- VAR
- t_str : STRING[4];
-
- BEGIN;
-
- {$IFDEF DEBUG_1}
- WRITELN('Command TNC -- ', cmd_string^);
- DELAY(1000);
- {$ENDIF}
-
- WITH active_tcb^ DO
- BEGIN;
-
- {$IFDEF DEBUG_1}
- WRITELN('Command TNC -- #2 -- ', LENGTH(cmd_string^));
- DELAY(1000);
- {$ENDIF}
-
- IF display_switch THEN
- BEGIN;
- t_str := port_chan_s + '^:';
- window_write(t_str, cmd_string^);
- END;
-
- {$IFDEF DEBUG_1}
- WRITELN('Long move');
- DELAY(1000);
- {$ENDIF}
-
- l_move_str(@tnc_data, cmd_string^);
-
- {$IFDEF DEBUG_1}
- WRITELN('Command TNC -- ', tnc_data.long_length);
- DELAY(1000);
- {$ENDIF}
-
-
- IF tnc_data.long_length = 0 THEN
- tnc_null := TRUE
- ELSE
- send_recv_tnc(info_cmd_cmd);
-
- IF display_switch THEN
- BEGIN;
- t_str[3] := '-';
- IF (tnc_data.long_length > 0) THEN
- window_write(t_str, tnc_data.str_data)
- ELSE
- window_write(t_str, 'OK');
- END;
-
- END;
-
- END;
-
- (*===========================================================================*)
- (* End a session -- There is no exit from this..... *)
- (*===========================================================================*)
-
- PROCEDURE end_session(add_delay : BOOLEAN);
-
- VAR
- t : LONGINT;
-
- BEGIN;
-
- send_drain;
-
- IF add_delay THEN
- task_wait(active_port^.disc_delay, TRUE);
-
- cmd_tnc(@disc_cmd, TRUE);
-
- WITH active_tcb^ DO
- IF NOT tnc_null THEN
- BEGIN;
- active_port^.connected^[channel] := NIL;
- task_destroy_active;
- END;
-
- WITH active_tcb^ DO
- IF (window = window_operator) AND NOT tcb_ignore_lc THEN
- window := window_connect;
-
- t := time_from_now(600);
-
- WHILE t > current_day_time DO
- BEGIN;
- read_flush;
- task_switch;
- END;
-
- window_write_critical(active_tcb^.port_chan_s + 'D:',
- 'Forcing disconnected task after wait');
- task_destroy_active;
-
- END;
-
- (*===========================================================================*)
- (* End a session -- Timeout *)
- (*===========================================================================*)
-
- PROCEDURE timer_end_session;
-
- BEGIN;
-
- (*-----------------------------------------------------------------------*)
- (* Time expired. Tell user then dump the connection. *)
- (*-----------------------------------------------------------------------*)
-
- send_message(message_to_noact);
- send_flush;
-
- WHILE send_unacked(TRUE) > 0 DO
- BEGIN;
- task_switch;
- read_flush;
- END;
-
- end_session(TRUE);
-
- END;
-
- (*===========================================================================*)
- (* task wait *)
- (*===========================================================================*)
-
- PROCEDURE task_wait(seconds_to_wait : WORD; poll_during_wait : BOOLEAN);
-
- VAR
- i : BYTE;
- wait_until_time : LONGINT;
-
- BEGIN;
-
- wait_until_time := up_time_from_now(seconds_to_wait);
-
- REPEAT;
- task_switch;
- IF poll_during_wait THEN
- i := send_pending(FALSE);
- UNTIL (wait_until_time <= up_time);
-
- END;
-
- END.